home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-20 / nrd33.zip / NRDUTIL.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-19  |  17KB  |  550 lines
  1. {$I-}
  2. {$V-}
  3.  
  4. unit nrdutil;
  5.  
  6. interface
  7.   uses crt, screen, nrdio;
  8.  
  9.   type  prompttype    = (PAGE1, PAGE2);
  10.  
  11.   const
  12.   { Receiver window screen limits }
  13.       REC_WIN_X_TOP    = 1;
  14.       REC_WIN_Y_TOP    = 1;
  15.       REC_WIN_X_BOTTOM = 79;
  16.       REC_WIN_Y_BOTTOM = 5;
  17.  
  18.       REVISION         = '3.3';
  19.  
  20.   var x_pos, y_pos:integer;
  21.       prompt_num:prompttype;
  22.  
  23.   procedure sort(var data:sort_array_type; var index:recarraytype;
  24.                start, points:integer);
  25.  
  26.   procedure editfield(x,y,fieldlen:integer; number:boolean;
  27.                       var tabkey, backtabkey:boolean; var val:lstring);
  28.  
  29.   procedure top_window;
  30.   procedure bottom_window;
  31.   procedure write_prompt(s:string);
  32.   procedure cmd_prompt(prompt_num:prompttype);
  33.   procedure do_help;
  34.  
  35. implementation
  36.  
  37.   procedure sort;
  38.   (* THIS PROCEDURE IMPLEMENTS 'QUICKSORT' BY C.A.R. HOARE. THIS N*LOG(N) *)
  39.   (* ALGORITHM IS A PARTITION EXCHANGE SORT AND IS DOCUMENTED IN THE 7-80 *)
  40.   (* ISSUE OF 'MICRO'.                                                    *)
  41.  
  42.   TYPE STACKTYPE = RECORD
  43.        UPPER:1..MAXREC; (*STORAGE FOR UPPER SEARCH RANGE*)
  44.        LOWER:1..MAXREC    (*   "     "  LOWER    "     "  *)
  45.      END;
  46.  
  47.   VAR P,Q (*CURRENT LOWER & UPPER INDEX BOUNDS TO BE SORTED. DATA[P] IS
  48.           USED AS A COMPARISON KEY IN THE SORTING PROCESS.           *)
  49.        ,I   (*STARTS AT P & IS INCREMENTED UNTIL DATA[I]>=DATA[P].       *)
  50.        ,J   (*STARTS AT Q & IS DECREMENTED UNTIL DATA[I]<=DATA[P].       *)
  51.        ,STACKPTR:INTEGER;
  52.     STACK:PACKED ARRAY[1..MAXREC] OF STACKTYPE; (*SEARCH RANGE STORAGE.*)
  53.     TEMPDATA,VALUE (*DATA[P]*):short_str;
  54.     TEMPINDEX:1..MAXREC;
  55.   BEGIN
  56.     P:=start; Q:=POINTS + start - 1; STACKPTR:=0;
  57.     REPEAT
  58.       WHILE P < Q DO
  59.       BEGIN
  60.         VALUE:=DATA[P]; I:=P; J:=Q + 1;
  61.         REPEAT
  62.           REPEAT J:=J - 1 UNTIL DATA[J]<=VALUE;
  63.           REPEAT inc(I)   UNTIL DATA[I]>=VALUE;
  64.           IF J > I THEN
  65.         BEGIN
  66.           TEMPDATA:=DATA[I]; TEMPINDEX:=INDEX[I];
  67.           DATA[I] :=DATA[J]; INDEX[I] :=INDEX[J];
  68.           DATA[J] :=TEMPDATA;INDEX[J] :=TEMPINDEX
  69.         END;
  70.         UNTIL J <= I;
  71.         TEMPINDEX:=INDEX[P];
  72.         DATA[P]:=DATA[J]; INDEX[P]:=INDEX[J];
  73.         DATA[J]:=VALUE;   INDEX[J]:=TEMPINDEX;
  74.         inc(STACKPTR);
  75.         IF J - P < Q - J
  76.           THEN
  77.         WITH STACK[STACKPTR] DO
  78.           BEGIN LOWER:=J + 1; UPPER:=Q; Q:=J - 1
  79.           END
  80.           ELSE
  81.         WITH STACK[STACKPTR] DO
  82.           BEGIN LOWER:=P; UPPER:=J - 1; P:=J + 1
  83.           END;
  84.       END; (*WHILE*)
  85.     write(output,'.');
  86.     IF STACKPTR > 0 THEN (*GRAB NEW SEARCH RANGE OFF STACK*)
  87.       WITH STACK[STACKPTR] DO BEGIN Q:=UPPER; P:=LOWER END;
  88.     STACKPTR:=STACKPTR-1
  89.     UNTIL STACKPTR < 0 (*EMPTY STACK*)
  90.   END;
  91.  
  92.  
  93.   procedure editfield;
  94.  
  95.   { parameters: x,y     = cursor position
  96.         fieldlen = allowable length for field
  97.         number     = flag that if true restricts the keys usable
  98.         val     = return string }
  99.  
  100.   var ptr,i:integer;
  101.       ch:char;
  102.       errflg,flag,insert_mode:boolean;
  103.       oldval:string[255];
  104.  
  105.     procedure show_line(x,y,fieldlen:integer; val:lstring; edit:boolean);
  106.     var i:integer;
  107.         lf_bracket,rt_bracket:char;
  108.     begin { show_line }
  109.       gotoxy(x,y + 1);
  110.       if edit then { they are editing this line }
  111.         begin
  112.       lf_bracket:='[';
  113.           rt_bracket:=']';
  114.       writea(RED,BACKGROUND);
  115.       writea(BLACK,FOREGROUND);
  116.         end
  117.       else
  118.         begin
  119.       writea(CYAN,BACKGROUND);
  120.       writea(BLACK,FOREGROUND);
  121.           lf_bracket:=' ';
  122.       rt_bracket:=' ';
  123.         end;
  124.       write(lf_bracket,val);
  125.       gotoxy(x + 1 + fieldlen,y + 1);
  126.       write(rt_bracket);
  127.     end; { show_line }
  128.  
  129.     procedure blankfill(fieldlen:integer; var val:lstring);
  130.     begin
  131.       while length(val) < fieldlen do val:=concat(val,' ');
  132.     end;
  133.  
  134.  
  135.     procedure get_normal;
  136.  
  137.     { fetch normal character and display it.  Handle field overflow and
  138.       insert_mode }
  139.  
  140.     var i:integer;
  141.     s:string[1];
  142.     begin
  143.       if ptr < fieldlen
  144.     then
  145.       begin
  146.         if ((number) and (ch in ['0'..'9',' ','.']))
  147.         or ((ptr = 0) and (ch = '-')) or not number then
  148.           begin { all's well }
  149.         if not insert_mode then
  150.           begin
  151.             write(ch); { echo character to screen }
  152.             ptr:=ptr + 1;
  153.             val[ptr]:=ch
  154.           end
  155.         else { handle insert mode }
  156.           begin
  157.             inc(ptr);
  158.             for i:=fieldlen downto ptr do val[i]:=val[i - 1];
  159.             val[ptr]:=ch;
  160.             for i:=ptr to fieldlen do write(val[i]);
  161.             gotoxy(x + ptr + 1,y + 1);
  162.           end
  163.           end
  164.       end
  165.     end; { get_normal }
  166.  
  167.     procedure do_backspace;
  168.     begin
  169.       if ptr > 0 then { it's ok to backspace }
  170.     begin
  171.       ptr:=ptr - 1;
  172.       gotoxy(x + ptr + 1,y + 1)
  173.     end
  174.     end;
  175.  
  176.     procedure do_forwardspace;
  177.     begin
  178.       if ptr < fieldlen then { its ok to forward space }
  179.     begin
  180.       inc(ptr);
  181.       gotoxy(x + ptr + 1,y + 1)
  182.     end
  183.     end;
  184.  
  185.     procedure do_del;
  186.     var i:integer;
  187.     begin
  188.       for i:=ptr + 1 to fieldlen - 1 do val[i]:=val[i + 1];
  189.       val[fieldlen]:=' ';
  190.       for i:=ptr + 1 to fieldlen do write(val[i]);
  191.       gotoxy(x + ptr + 1,y + 1);
  192.     end;
  193.  
  194.     procedure do_rub;
  195.     var i:integer;
  196.     begin
  197.       if ptr > 0 then ptr:=ptr - 1;
  198.       gotoxy(x + ptr + 1,y + 1);
  199.       do_del;
  200.     end;
  201.  
  202.     procedure toggle_insert;
  203.     begin
  204.       insert_mode:=not insert_mode;
  205.    end;
  206.  
  207.    procedure do_home;
  208.    begin
  209.      ptr:=0;
  210.      gotoxy(x + ptr + 1,y + 1)
  211.    end;
  212.  
  213.    procedure do_end;
  214.    begin
  215.      ptr:=fieldlen;
  216.      while (ptr > 0) and (val[ptr] = ' ') do
  217.        ptr:=ptr - 1;
  218.      gotoxy(x + ptr + 1,y + 1)
  219.    end;
  220.  
  221.    procedure do_tab;
  222.    begin
  223.      tabkey:=TRUE;
  224.      ch:=chr(13);
  225.    end;
  226.  
  227.    procedure do_backtab;
  228.    begin
  229.      backtabkey:=TRUE;
  230.      ch:=chr(13);
  231.    end;
  232.  
  233.   begin { editfield }
  234.     insert_mode:=FALSE;
  235.     tabkey:=FALSE;
  236.     backtabkey:=FALSE;
  237.     if number and (val = '-0.00') then val:='0.00';
  238.     oldval:=val; { save copy in case they abort }
  239.     if length(val) > fieldlen then val:=copy(val,1,fieldlen);
  240.     blankfill(fieldlen,val);
  241.     ptr:=0;
  242.     show_line(x,y,fieldlen,val,TRUE);
  243.     gotoxy(x + 1,y + 1);
  244.     repeat
  245.       ch:=fetch;
  246.       if (ch <> chr(13)) and (ord(ch) >= ord(' ')) then get_normal
  247.       else if ch = keyinfo.bskey   then do_backspace
  248.       else if ch = keyinfo.fskey   then do_forwardspace
  249.       else if ch = keyinfo.delkey  then do_del
  250.       else if ch = keyinfo.rubkey  then do_rub
  251.       else if ch = keyinfo.inskey  then toggle_insert
  252.       else if ch = keyinfo.homekey then do_home
  253.       else if ch = keyinfo.endkey  then do_end
  254.       else if ch = keyinfo.tabkey  then do_tab
  255.       else if ch = keyinfo.backtabkey then do_backtab
  256.     until (ch = chr(13)) or (ch = keyinfo.esckey);
  257.  
  258.     if number then { strip off trailing blanks }
  259.       begin
  260.     ptr:=length(val);
  261.     flag:=TRUE;
  262.     while (ptr > 0) and flag do
  263.       begin
  264.         flag:=val[ptr] = ' ';
  265.         if flag then delete(val,ptr,1);
  266.         ptr:=ptr - 1;
  267.       end;
  268.       end;
  269.     show_line(x,y,fieldlen,val,FALSE);
  270.   end; { editfield }
  271.  
  272.   procedure top_window;
  273.   begin
  274.     window(REC_WIN_X_TOP,REC_WIN_Y_TOP,REC_WIN_X_BOTTOM+1,REC_WIN_Y_BOTTOM);
  275.   end;
  276.  
  277.   procedure bottom_window;
  278.   begin
  279.     window(1,REC_WIN_Y_BOTTOM + 1, 80,24);
  280.     gotoxy(x_pos,y_pos);
  281.   end;
  282.  
  283.   procedure write_prompt;
  284.  
  285.   { write green prompt at top of top window; leave with light gray foreground
  286.     and in top window }
  287.  
  288.   begin
  289.     top_window;
  290.     writea(GREEN,FOREGROUND);
  291.     writea(BLACK,BACKGROUND);
  292.     gotoxy(1,1);
  293.     clreol;
  294.     write(output,s);
  295.     writea(LIGHTGRAY,FOREGROUND);
  296.   end;
  297.  
  298.   procedure cmd_prompt;
  299.   const T0 = 'NRD'+REVISION;
  300.         T1 = ': L(og, C(onfirm, S(ort, E(dit, T(une, P(age, H(elp, ';
  301.         T2 = 'Q(uit [/]';
  302.         T3 = 's-meteR, ';
  303.   begin
  304.     case prompt_num of
  305.       PAGE1: if has_map then write_prompt(T0+T1+'K(iwa, '+T2)
  306.              else if radio_type = 525 then write_prompt(T0+T1+T2)
  307.              else write_prompt(T0+T1+T3+T2);
  308.       PAGE2:write_prompt(T0+
  309.   ': D(elete, uN(delete, M(ark, U(nmark, J(ournal, A(lternate, W(rite [/]');
  310.     end;
  311.   end;
  312.  
  313.   procedure do_help;
  314.   var ch:char;
  315.  
  316.     procedure help_commands;
  317.     var ch:char;
  318.     begin
  319.       write_prompt('Help -- Receiver display  <Hit any key to return>');
  320.       window(1,REC_WIN_Y_BOTTOM + 1, 80,25);
  321.       home;
  322.       writeln(output,
  323. 'Commands are designed to be easy to learn and use.  All commands are');
  324.       writeln(output,
  325. 'activated with a single key and are spelled out on the command line.  For');
  326.       writeln(output,
  327. 'example, to log a station, hit "L" (shows up as "L(og" on prompt).');
  328.       writeln(output);
  329.       writeln(output,'Command Summary:');
  330.       writeln(output);
  331.       writeln(output,
  332. '/: Toggles command menu (commands from both menus are always active)');
  333.       writeln(output,
  334. 'L: Log (creates new entry in log, receiver contents automatically included)'
  335.           );
  336.       writeln(output,
  337. 'C: Confirm (updates time, date, receiver contents for highlighted entry)');
  338.       writeln(output,
  339. 'S: Sort data base with 2 sort keys');
  340.       writeln(output,
  341. 'E: Edit field where cursor is located.  Hit ENTER or a TAB key when done');
  342.       writeln(output,
  343. 'T: Tune receiver to highlighted entry.  Updates all receiver parameters');
  344.       writeln(output,
  345. 'P: Page right (the contents for an entry span 3 pages, faster than tabs)');
  346. writeln(output,'D: Deletes a log entry');
  347.       writeln(output,
  348. 'N: uNdeletes a log entry (logging new stations reuses deleted space)');
  349.      writeln(output,
  350. 'M: Mark line(s) for writing or moving to other datalogs (see Journal)');
  351.       writeln(output,'U: Unmark lines');
  352.       writeln(output,'A: Alternates between Active and Inactive Logs');
  353.       writeln(output,'W: Write entry from Inactive Log to Active Log');
  354. write(output,'Q: Quits the program');
  355.  
  356.       ch:=fetch;
  357.       home;
  358.     end;
  359.  
  360.     procedure help_more;
  361.     var ch:char;
  362.     begin
  363.       write_prompt('Help -- More Commands  <Hit any key to return>');
  364.       bottom_window;
  365.       home;
  366.       writeln(output,
  367. 'J: Journal: allows you to select other data logs and do things with them.');
  368.       writeln(output,
  369. '         I keep multiple logs -- a music log for stations that play');
  370.       writeln(output,
  371. '         interesting music and target logs for areas I''m trying to get.');
  372.       writeln(output,
  373. '         Target logs allow you to scan what''s there VERY quickly.');
  374.       writeln(output,
  375. '         The Write command allows marked areas to be moved from'
  376.           );
  377.       writeln(output,
  378. '         one database to another; like when you find one of those targets!'
  379.           );
  380.       writeln(output,
  381. '         Move is like a write but deletes the marked entry.  Print writes');
  382.       writeln(output,
  383. '         the selected database to your printer.  Import will copy data');
  384.       writeln(output,
  385. '         from Tom Sundstrom''s English Language SW Broadcast Schedules to');
  386.       writeln(output,
  387. '         this program format.  You can order these from Tom (609) 859-2447.'
  388.           );
  389.       if has_map then
  390.         begin
  391.           writeln(output,
  392. 'K: KIWA (this only applies if you have a KIWA Map unit)  "K" toggles KIWA');
  393.           writeln(output,
  394. '         mode.  When enabled, the receiver is placed in AM and the radio');
  395.           writeln(output,
  396. '         is detuned a couple of Khz for good fidelity.  Stations logged or'
  397.           );
  398.           writeln(output,
  399. '         confirmed will be rounded to the nearest 5 Khz.  Disabling puts');
  400.           writeln(output,
  401. '         the radio in ECS mode with the appropriate sideband selected based'
  402.           );
  403.           writeln(output,
  404. '         on the offset.  The MAP unit provides synchronous detection for a'
  405.           );
  406.           writeln(output,
  407. '         525 and was described in Guy Atkin''s 9/90 NASWA article p.18.  To'
  408.           );
  409.           writeln(output,
  410. '         tell the program you have a MAP, delete the config.dat file and');
  411.           write(output,
  412. '         rerun program.');
  413.         end;
  414.       if radio_type = 535 then
  415.         begin
  416.           writeln(output,
  417. 'R: s-meteR: Toggles mode of periodically updating computer S-Meter display.'
  418.           );
  419.           writeln(output,
  420. '         Unfortunately, reading the S-Meter can cause annoying synthesizer'
  421.           );
  422.           writeln(output,
  423. '         re-locking noise in LSB, USB, CW, and RTTY modes.  Use this mode');
  424.           writeln(output,
  425. '         to disable this when it bothers you');
  426.         end;
  427.       ch:=fetch;
  428.     end;
  429.  
  430.     procedure help_receiver;
  431.     var ch:char;
  432.     begin
  433.       write_prompt('Help -- Receiver display  <Hit any key to return>');
  434.       bottom_window;
  435.       home;
  436.       gotoxy(1,3);
  437.       writeln(output,
  438. 'The box labled "NRD',radio_type
  439. ,' Status" contains the last sampled receiver status.'
  440.           );
  441.       writeln(output,
  442. 'Mostly, this is self-explanatory.  BW = Bandwidth, Freq is the receiver'
  443.           );
  444.       writeln(output,
  445. 'frequency.  If the attenuator is active, you will see "ATT" at the right'
  446.           );
  447.       writeln(output,
  448. 'of the screen.  If you said you had a KIWA Map unit and it is active, you'
  449.           );
  450.       writeln(output,
  451. 'will see a "K" at the far right of the status box.  The KIWA features are'
  452.           );
  453.       writeln(output,
  454. 'described in the commands section.  If you don''t have one, don''t worry'
  455.           );
  456.       writeln(output,
  457. 'about this.  Normally, the status is displayed in CYAN unless something'
  458.           );
  459.       writeln(output,
  460. 'has changed since the last sample.  Changes are displayed in RED.  To cause'
  461.           );
  462.       writeln(output,
  463. 'the receiver status to be sampled, hit any non-command key (like space).'
  464.           );
  465.       writeln(output,
  466. 'This approach to updating the display was chosen deliberately to keep the'
  467.           );
  468.       write(output,
  469. 'radio "unlocked" so you can punch up commands on the radio.');
  470.       ch:=fetch;
  471.     end;
  472.  
  473.     procedure help_other;
  474.     var ch:char;
  475.     begin
  476.       write_prompt('Help -- Receiver display  <Hit any key to return>');
  477.       bottom_window;
  478.       home;
  479.       gotoxy(1,3);
  480.       writeln(output,
  481. 'There are other useful keys not covered in the command section.  First off,'
  482.           );
  483.       writeln(output,
  484. 'all the normal cursor commands work including tabs.  HOME takes you to the'
  485.           );
  486.       writeln(output,
  487. 'top of the display log, END takes you to the bottom.  Control-PAGE keys'
  488.           );
  489.       writeln(output,
  490. 'work like PAGE keys, only 10 pages at a time.  "+" and "-" keys bump the'
  491.           );
  492.       writeln(output,
  493. 'frequency up or down 5 Khz.  If you are in USB or LSB mode, the program'
  494.           );
  495.       writeln(output,
  496. 'assumes you are using ECS detection and tunes off 1 Khz for a fraction of'
  497.           );
  498.       writeln(output,
  499. 'a second before tuning in the correct frequency.  This feature was added to'
  500.           );
  501.       writeln(output,
  502. 'hear the heterodyne of weak stations you might miss while rapidly scanning.'
  503.           );
  504.       writeln(output,
  505. 'The "<" and ">" keys (or the "," and "." keys so no shifting is needed)'
  506.           );
  507.       writeln(output,
  508. 'decrement or increment the receiver mode.  Similarly, the "[" and "]" keys'
  509.           );
  510.       writeln(output,
  511. 'bump the receiver bandwidth selection.  "*" will find the closest');
  512.       writeln(output,
  513. 'log entry for the currently tuned frequency');
  514.       writeln(output);
  515.       writeln(output,
  516. 'The offset from GMT to your computer''s time is stored in the "CONFIG.DAT"'
  517.           );
  518.       writeln(output,
  519. 'file.  If this is wrong, delete CONFIG.DAT and the program will prompt you'
  520.           );
  521.       write(output,
  522. 'for the information to correct.');
  523.       ch:=fetch;
  524.     end;
  525.  
  526.   begin
  527.     repeat
  528.       bottom_window;
  529.       home;
  530.       gotoxy(1,8);
  531.       writeln(output,
  532. 'Type letter for command.  For example, to learn more about the receiver');
  533.       writeln(output,
  534. 'display, type "r".  Type "q" to return from the help facility.');
  535.       write_prompt(
  536. 'Help: R(eceiver display, C(ommands, M(ore commands, O(ther, Q(uit');
  537.       ch:=upcase(fetch);
  538.       case ch of
  539.         'R': help_receiver;
  540.         'C': help_commands;
  541.         'M': help_more;
  542.         'O': help_other;
  543.       end;
  544.     until ch = 'Q';
  545.     cmd_prompt(prompt_num);
  546.     bottom_window;
  547.   end;
  548.  
  549. begin
  550. end.